//=============================================================================
///	Evaluate expression
//=============================================================================

#include "seval.h"
#include "sexp.h"
#include "senv.h"
#include "sutil.h"

#ifndef	FALSE
#define	FALSE	(0)
#define	TRUE	(1)
#endif

const char ERR_UNBOUND_SYMBOL[]		= "unbound: ~s";
const char ERR_STACK_OVERFLOW[]		= "stack overflow";
const char ERR_STACK_UNDERFLOW[]	= "stack underflow";

extern SExp call_list;
extern SExp current_eval_exp;

SExp apply(SExp fn, SExp args, int not_evaled) {
	if (sptrp(fn)) {
		SExp (*papply)(SExp, SExp, int) = fn.ptr->hdr.typeinfo->apply;
		if (papply != NULL) {
			SExp r;
//			call_list = cons(cons(fn, args), call_list);
			r = papply(fn, args, not_evaled);
//			call_list = cdr(call_list);
			return r;
		}
	}
	error("can't call: ~a, args:~a", fn, args);
	return nil;
}


SExp compile(SExp s) {
	// Currently macroexpand only.
	return macroexpand(s, s);
}

SExp run(SExp s) {
	SExp res;
	SExp prev = current_eval_exp;
	current_eval_exp = s;
	if (!consp(s)) {
		if (symbolp(s)) {
			SExp r = getvar(s);
			if (eq(r, sUNDEF)) {
				res = error(ERR_UNBOUND_SYMBOL, s);
			} else {
				res = r;
			}
		} else {
			// Literal: self evaluated
			res = s;
		}
	} else {
		SExp fn, args;
		push_stack(s);
		fn = run(car(s));
		push_stack(fn);
		args = cdr(s);
		res = apply(fn, args, TRUE);
		pop_stack(2);
	}
	current_eval_exp = prev;
	return res;
}

SExp eval(SExp s) {
	SExp c, r;

	push_stack(s);
	c = compile(s);
	pop_stack(1);

	push_stack(c);
	r = run(c);
	pop_stack(1);

	return r;
}



/**
	@desc
		This function do not change environment,
		so caller must set environment
*/
SExp macroexpand_1(SExp self, SExp s) {
	const STypeInfo* typeinfo = get_type_info(self);
	SExp (*f)(SExp, SExp) = typeinfo->macroexpand;
	if (f != NULL) {
		SExp r;
		push_stack(s);
		r = (*f)(self, s);
		pop_stack(1);
		return r;
	} else {
		return s;
	}
}


/**
	@desc
		This function do not change environment,
		so caller must set environment
*/
SExp macroexpand(SExp self, SExp s) {
	for (;;) {
		SExp r = macroexpand_1(self, s);
		if (eq(r, s)) {
			return r;
		}
		self = s = r;
	}
}





#define	STACK_SIZE	(4096)
SExp stack[STACK_SIZE];
static int sp;

void push_stack(SExp s) {
	if (sp < STACK_SIZE) {
		stack[sp++] = s;
	} else {
		error(ERR_STACK_OVERFLOW);
	}
}

SExp pop_stack(int n) {
	assert(n >= 0);
	sp -= n;
	if (sp >= 0) {
		return stack[sp];
	} else {
		error(ERR_STACK_UNDERFLOW);
		sp = 0;
		return nil;
	}
}

SExp ref_stack(int ofs) {
	int idx = sp - ofs;
	assert(idx >= 0);
	return stack[idx];
}

/**
before:
	stack:...[d][a]
after:
	stack:...[cons(a, d)]
*/
void cons_on_stack(void) {
	SExp a = ref_stack(1);
	SExp d = ref_stack(2);
	SExp c = cons(a, d);
	pop_stack(2);
	push_stack(c);
}

/**
before:
	stack:...[a][d]
after:
	stack:...[cons(a, d)]
*/
void cons_on_stack_rev(void) {
	SExp d = ref_stack(1);
	SExp a = ref_stack(2);
	SExp c = cons(a, d);
	pop_stack(2);
	push_stack(c);
}


SExp pop_nrev_stack(void) {
	return nreverse(pop_stack(1));
}



#include "smem.h"
void mark_stack(void) {
	int i;
	for (i=0; i<sp; ++i) {
		SExp s = stack[i];
		SMARK(s);
	}
}




int evlis(SExp** pframe, SExp ls, int b_eval) {
	int idx = sp;
	SExp p;
	// Evaluate all arguments
	for (p = ls; !nilp(p); p = cdr(p)) {
		SExp v = car(p);
		if (b_eval) {
			push_stack(run(v));
		} else {
			push_stack(v);
		}
	}
	*pframe = &stack[idx];
	return sp - idx;
}

